home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8412.arc / BENCH.MOD < prev    next >
Text File  |  1986-09-14  |  3KB  |  156 lines
  1. MODULE Benchmark;
  2.  
  3. (* This benchmark program (with minor changes)
  4.    is from "The Personal Computer Lilith," by N. Wirth, 
  5.    Institute fur Informatik, ETH Zurich, 1981.          *)
  6.  
  7. FROM Storage IMPORT ALLOCATE;
  8. FROM Terminal IMPORT Read, Write, WriteLn;
  9.  
  10. TYPE
  11.   NodePtr = POINTER TO Node;
  12.   Node = RECORD
  13.              x, y : CARDINAL;
  14.              next : NodePtr;
  15.            END;
  16.  
  17. VAR
  18.   a, b, c : ARRAY [0..255] OF CARDINAL;
  19.   M       : ARRAY [0..99], [0..99] OF CARDINAL;
  20.   m       : CARDINAL;    
  21.   head    : NodePtr;
  22.  
  23.   PROCEDURE Test(ch : CHAR);
  24.   VAR
  25.     i, j, k : CARDINAL;
  26.     p : NodePtr;
  27.  
  28.     PROCEDURE P;
  29.     BEGIN
  30.     END P;
  31.  
  32.     PROCEDURE Q(x, y, z, w : CARDINAL);
  33.     BEGIN
  34.     END Q;
  35.  
  36.   BEGIN
  37.     CASE ch OF 
  38.       (*----- Loops -----*)
  39.       'a' : (* Empty REPEAT loop *) 
  40.            k := 20000;
  41.               REPEAT
  42.               k := k - 1;
  43.            UNTIL k = 0 |
  44.  
  45.       'b' : (* Empty WHILE loop *)     
  46.            i := 20000;
  47.            WHILE i > 0 DO
  48.               i := i - 1;
  49.            END |
  50.  
  51.       'c' : (* Empty FOR loop *)
  52.               FOR i := 1 TO 20000 DO
  53.            END |
  54.  
  55.       (*----- Cardinal Arithmetic -----*)
  56.       'd' : (* CARDINAL arithmetic *)
  57.            j := 0;
  58.            k := 10000;
  59.            REPEAT
  60.                k := k - 1;
  61.                j := j + 1;
  62.                i := (k * 3) DIV (j * 5);
  63.            UNTIL k = 0 |
  64.  
  65.       (*----- Array Indexing -----*)
  66.       'e' : (* Array of single dimension *) 
  67.            k := 20000;
  68.            i := 0;
  69.            b[0] := 73;
  70.            REPEAT
  71.               a[i] := b[i];
  72.               b[i] := a[i];
  73.               k := k - 1;
  74.            UNTIL k = 0 |
  75.  
  76.       'f' : (* Two-dimensional array *)
  77.            FOR i := 0 TO 99 DO
  78.              FOR j := 0 TO 99 DO
  79.                M[i, j] := M[j, i];
  80.              END;
  81.            END |
  82.  
  83.       (*----- Procedure Calls -----*)
  84.       'g' : (* Call of empty, parameterless procedure *)
  85.            k := 20000;
  86.            REPEAT
  87.              P;
  88.              k := k - 1;
  89.            UNTIL k = 0 |
  90.  
  91.       'h' : (* Call of empty procedure with four parameters *) 
  92.            k := 20000;
  93.            REPEAT
  94.               Q(i, j, k, m);
  95.               k := k - 1;
  96.            UNTIL k = 0 |
  97.  
  98.       (*----- Block Move -----*)
  99.       'i' : (* Copying arrays (block moves) *)
  100.            k := 500;
  101.            REPEAT
  102.               k := k - 1;
  103.               a := b;
  104.               b := c;
  105.               c := a;
  106.            UNTIL k = 0 |
  107.  
  108.       'j' : (* Pointer chaining *) 
  109.            k := 500;
  110.            REPEAT
  111.               p := head;                       
  112.               REPEAT
  113.                  p := p^.next;
  114.               UNTIL p = NIL;
  115.               k := k - 1;
  116.            UNTIL k = 0
  117.     END;
  118.  
  119.   END Test;
  120.  
  121. VAR
  122.   ch      : CHAR;
  123.   n       : CARDINAL;
  124.   q       : NodePtr;
  125.  
  126. BEGIN (* of MODULE Benchmark *)
  127.  
  128.   head := NIL;
  129.   n := 100;
  130.   REPEAT  (* initialize list *)
  131.     q := head;
  132.     NEW(head);
  133.     head^.next := q;
  134.     n := n - 1;
  135.   UNTIL n = 0;
  136.  
  137.   Write('>');
  138.   Read(ch);
  139.   WHILE ('a' <= ch) & (ch <= 'j') DO 
  140.     Write(ch);
  141.     WriteLn;
  142.     n := 0;
  143.     REPEAT
  144.       n := n + 1;
  145.       Test(ch); (* call the test routine *)
  146.       IF (n MOD 50) = 0 THEN
  147.         WriteLn;
  148.       END;
  149.       Write('.');
  150.     UNTIL n = 100; 
  151.     WriteLn;
  152.     Write('>');
  153.     Read(ch);
  154.   END;
  155. END Benchmark.
  156.